home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel-075.lha / feel0.75 / Src / main.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  29KB  |  1,292 lines
  1. /* ******************************************************************** */
  2. /*  main.c           Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* User top level                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: main.c,v 1.22 1992/06/18 10:01:24 pab Exp $
  9.  *
  10.  * $Log: main.c,v $
  11.  * Revision 1.22  1992/06/18  10:01:24  pab
  12.  * improved includes, decls
  13.  *
  14.  * Revision 1.21  1992/06/16  19:38:08  pab
  15.  * feelrc mods
  16.  *
  17.  * Revision 1.20  1992/06/09  14:03:59  pab
  18.  * more BCI paranoia
  19.  *
  20.  * Revision 1.19  1992/05/28  17:04:32  rjb
  21.  * a NULL -> 0
  22.  *
  23.  * Revision 1.18  1992/05/26  11:28:03  pab
  24.  * map option added
  25.  *
  26.  * Revision 1.17  1992/05/19  11:19:22  pab
  27.  * -boot option
  28.  *
  29.  * Revision 1.16  1992/04/26  21:02:27  pab
  30.  * symbol fixes
  31.  *
  32.  * Revision 1.15  1992/03/13  18:08:06  pab
  33.  * SysV fixes (interpreter thread sort out)
  34.  *
  35.  * Revision 1.14  1992/02/18  11:16:06  pab
  36.  * added handler
  37.  *
  38.  * Revision 1.13  1992/02/11  13:38:32  pab
  39.  * fixed generic version
  40.  *
  41.  * Revision 1.12  1992/02/11  12:06:05  pab
  42.  * handler around load of initcode
  43.  *
  44.  * Revision 1.11  1992/02/10  12:07:02  pab
  45.  * Bytecode support
  46.  *
  47.  * Revision 1.10  1992/01/29  13:42:12  pab
  48.  * sysV fixes
  49.  *
  50.  * Revision 1.9  1992/01/17  22:31:19  pab
  51.  * fixed to load initcode at startup
  52.  *
  53.  * Revision 1.7  1992/01/09  22:28:53  pab
  54.  * Fixed for low tag ints
  55.  *
  56.  * Revision 1.6  1991/12/22  15:14:18  pab
  57.  * Xmas revision
  58.  *
  59.  * Revision 1.5  1991/11/15  13:45:08  pab
  60.  * copyalloc rev 0.01
  61.  *
  62.  * Revision 1.4  1991/10/08  19:27:42  pab
  63.  * arg to init_elvira changed
  64.  *
  65.  * Revision 1.3  1991/09/22  19:14:37  pab
  66.  * Fixed obvious bugs
  67.  *
  68.  * Revision 1.2  1991/09/11  12:07:24  pab
  69.  * 11/9/91 First Alpha release of modified system
  70.  *
  71.  * Revision 1.1  1991/08/12  16:49:47  pab
  72.  * Initial revision
  73.  *
  74.  * Revision 1.18  1991/04/03  21:06:36  kjp
  75.  * -cons-cut-off option
  76.  *
  77.  * Revision 1.17  1991/04/03  16:28:06  kjp
  78.  * History modifications - incomplete
  79.  *
  80.  * Revision 1.16  1991/04/02  16:41:32  kjp
  81.  * Conses command line option.
  82.  *
  83.  * Revision 1.15  1991/02/28  14:00:52  kjp
  84.  * Command line stack-space option.
  85.  *
  86.  * Revision 1.14  1991/02/13  18:23:09  kjp
  87.  * Pass.
  88.  *
  89.  */
  90.  
  91. #define JMPDBG(x)
  92. #define CODBG(x) /* fprintf(stderr,"CODBG:");x;fflush(stderr) */
  93.  
  94. /*
  95.  * Change Log:
  96.  *   Version 1, April 1989
  97.  *     Read a .feelrc file if it exists - JPff
  98.  *    Various changes for streams
  99.  *    Remove Env argument from make_module_function and make_special 
  100.  *        as always NULL
  101.  *    Initialise threads.
  102.  *      Added a one result history and fiddled with some object definitions.
  103.  */
  104.  
  105. #include "version.h"
  106.  
  107. #include "defs.h"
  108. #include "structs.h"
  109. #include "funcalls.h"
  110.  
  111. #include "error.h"
  112. #include "global.h"
  113. #include "slots.h"
  114. /*#include "compact.h" */
  115. #include "garbage.h" /* What do I need this for */
  116.  
  117. #include "symboot.h"
  118. #include "modules.h"
  119. #include "toplevel.h"
  120. #include "root.h"
  121. #include "specials.h"
  122. #include "lists.h"
  123. #include "listops.h"
  124. #include "calls.h"
  125. #include "ccc.h"
  126. #include "allocate.h"
  127.  
  128. #include "modboot.h"
  129.  
  130. #include "state.h"
  131. #include "macros.h"
  132. #include "semaphores.h"
  133. #include "format.h"
  134. #include "modops.h"
  135. #include "threads.h"
  136. #include "sio.h"
  137.  
  138. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  139. #include "sockets.h"
  140. #endif
  141.  
  142. #ifdef BCI
  143. #include "bvf.h"
  144. #endif
  145.  
  146. /*
  147.  * Hack number 1A - push everything as yet unmodulised into OTHER
  148.  */
  149.  
  150. #define OTHER_ENTRIES 24
  151. MODULE Module_others;
  152. LispObject Module_others_values[OTHER_ENTRIES];
  153.  
  154. /*
  155.  * The provided classes / constants / symbols
  156.  */
  157.  
  158. /* Built in constants */
  159.  
  160. LispObject nil;
  161. LispObject lisptrue;
  162. LispObject unbound;
  163.  
  164. /* Root class */
  165.  
  166. LispObject Object;
  167.  
  168. /* Meta classes */
  169.  
  170. LispObject  Standard_Class;
  171. LispObject   Slot_Description_Class;
  172.  
  173. LispObject Abstract_Class;
  174.  
  175. LispObject Slot_Description;
  176. LispObject  Local_Slot_Description;
  177.  
  178. LispObject Basic_Structure;
  179.  
  180. /* Allocation specifying metaclasses */
  181.  
  182. LispObject Structure_Class;                /* Analogous to C structs */
  183. LispObject Funcallable_Object_Class;       /* Function forms */
  184. LispObject Generic_Class;
  185. LispObject Pair_Class;
  186. LispObject Unpredictable_Fixed_Size_Class; /* Vector-type things */
  187. LispObject Variable_Size_Keyed_Class;      /* Tabular instances */
  188. LispObject Thread_Class;
  189. LispObject Method_Class;
  190.  
  191. /* Built in stuff */
  192.  
  193. LispObject Primitive_Class; 
  194.  
  195. /* The core building blocks */
  196.  
  197. LispObject Abstract_Class; /* Meta */
  198. LispObject Number, Complex, Real, Rational, Integer;
  199. LispObject Symbol, Character, String;
  200. LispObject Thread, Continue;
  201. LispObject Function, Generic, Method, Macro;
  202.  
  203. /* Composites */
  204.  
  205. LispObject Cons, Vector, Table, Null; /* Empty list... */
  206.  
  207. /* Special pointer */
  208.  
  209. LispObject Weak_Wrapper;
  210.  
  211. /* Flag thing */
  212.  
  213. LispObject last_evaluated_expression;         /* Input help */
  214. LispObject top_level(LispObject*);
  215. extern FILE* current_output;
  216.  
  217. static char *command_line_boot_file;
  218.  
  219. /* Quick way of making self evaluating sybols */
  220.  
  221. void make_special_symbol(LispObject *stacktop, LispObject *objptr, char *name )
  222. {
  223.   *objptr = (LispObject) get_symbol(stacktop, name );
  224.   lval_typeof(*objptr) = TYPE_SYMBOL;
  225.   gcof((*objptr))   = 0;
  226.   ((*objptr)->SYMBOL).right = NULL;
  227. }
  228.  
  229. /* Top level thread holder... */
  230.  
  231. LispObject interpreter_thread;
  232.  
  233. /* Temporary-ish jump buffer... */
  234.  
  235. LispObject tl_thread;
  236.  
  237. jmp_buf temp_buffer;
  238.  
  239. extern LispObject read_eval_print_continue;
  240. LispObject boot_thread;
  241.  
  242. int main(int argc, char ** argv)
  243. {
  244.   void load_and_boot(LispObject *);
  245.   extern void runtime_initialise_allocator(LispObject*);
  246.   void configure(int,char **);
  247.   void start_interpreter(LispObject*);
  248.  
  249.   LispObject *gc_local_stack;
  250.  
  251.   configure(argc,argv);
  252.  
  253.   /*
  254.  
  255.    * System initialisation...
  256.  
  257.    */
  258.  
  259.   runtime_initialise_system();     /* Rig system spec stuff */
  260.   runtime_initialise_allocator(NULL);  
  261.   runtime_initialise_garbage_collector(NULL);
  262.  
  263. #ifdef WITH_BYTECODE
  264. /* Initialize bytecode interpreter stack */
  265.  
  266.   init_stack();
  267. #endif
  268.  
  269.   OFF_collect();
  270.  
  271.   /*
  272.  
  273.    * We gotta rig up something so that we can use a few basic system
  274.    * functions during the main bootstrap sequence - this implies
  275.    * just setting up what will become the interpreter thread enough
  276.    * to get us moving...
  277.  
  278.    */
  279.  
  280.   /*
  281.  
  282.    * Set up preliminary thread stuff...
  283.  
  284.    */
  285.  
  286.   /* Interpreter GC stack (nominal, for bootstrapping)... */
  287.  
  288.   gc_local_stack = (LispObject*) malloc(4096*sizeof(LispObject*));
  289.   if (gc_local_stack ==  NULL) {
  290.     fprintf(stderr,"Really nasty error: unable to malloc gc_local_stack\n");
  291.     exit(1);
  292.   }
  293.  
  294.   fprintf(stderr,"stack: 0x%x Lim: 0x%x\n",
  295.       gc_local_stack,
  296.       gc_local_stack + 4096);
  297.   /* Allocate the top level thread... */
  298.  
  299.   nil = NULL;
  300.   Thread = NULL;
  301.  
  302.   boot_thread 
  303.     = allocate_thread(gc_local_stack,0,0,0);
  304.  
  305.   /* Fill in as best we can... */
  306.  
  307.   boot_thread->THREAD.stack_base = NULL;
  308.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  309.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  310.  
  311.   boot_thread->THREAD.stack_base = NULL;
  312.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  313.  
  314.   boot_thread->THREAD.stack_size = 0xffffffff; /* lots'n'lots */
  315.   boot_thread->THREAD.gc_stack_size = 100*HUNK_PAGE_SIZE()*sizeof(LispObject*);
  316.  
  317.   boot_thread->THREAD.fun = nil;
  318.   boot_thread->THREAD.args = nil;
  319.   boot_thread->THREAD.value = nil;
  320.   
  321.   boot_thread->THREAD.status = 0;
  322.  
  323.   boot_thread->THREAD.parent = nil;
  324.   boot_thread->THREAD.cochain = nil;
  325.  
  326.   /* Thread continuation... */
  327.  
  328.   boot_thread->THREAD.state->CONTINUE.thread = boot_thread;
  329.  
  330.   boot_thread->THREAD.state->CONTINUE.value = nil;
  331.   boot_thread->THREAD.state->CONTINUE.target = nil;
  332.  
  333. /*  boot_thread->THREAD.state.machine_state; */
  334.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  335.   boot_thread->THREAD.state->CONTINUE.dynamic_env = NULL;
  336.   boot_thread->THREAD.state->CONTINUE.last_continue = nil;
  337.   boot_thread->THREAD.state->CONTINUE.handler_stack = nil;
  338.  
  339.   boot_thread->THREAD.state->CONTINUE.live = FALSE;
  340.   boot_thread->THREAD.state->CONTINUE.unwind = FALSE;
  341.  
  342.   /*
  343.  
  344.    * We have a 'serviceable' thread - initialise the system specific
  345.    * bits for serial initialisation...
  346.  
  347.    */
  348.   { 
  349.     LispObject *stacktop;
  350.     
  351.     stacktop = load_thread(boot_thread); /* Context to this thread... */
  352.     add_root(&boot_thread);
  353.     load_and_boot(stacktop);          /* Do module boot sequence... */
  354.     
  355.     interpreter_thread=EUCALL_2(Fn_cons,nil,nil);
  356.     read_eval_print_continue=EUCALL_2(Fn_cons,nil,nil);
  357.     tl_thread=EUCALL_2(Fn_cons,nil,nil);
  358.  
  359.     add_root(&interpreter_thread);
  360.     add_root(&read_eval_print_continue);
  361.     add_root(&tl_thread);
  362.  
  363.     start_interpreter(stacktop);      /* Start the interpreter... */
  364.   }
  365. }
  366.  
  367. #define INTERPRETER_THREAD_STACK_SIZE  (64*1024*1)
  368. #define INTERPRETER_THREAD_GC_STACK_SIZE  (32*1024*1)
  369.  
  370.  
  371. #ifndef MACHINE_ANY
  372.  
  373. void start_interpreter(LispObject *stacktop)
  374. {
  375.   extern LispObject Fn_thread_start(LispObject*);
  376.   void start_history(void);
  377.  
  378.   LispObject function_read_eval_print;
  379.  
  380.   CAR(interpreter_thread) 
  381.     = allocate_thread(stacktop, INTERPRETER_THREAD_STACK_SIZE,
  382.               INTERPRETER_THREAD_GC_STACK_SIZE,0);
  383.  
  384.   function_read_eval_print =
  385.     allocate_module_function(stacktop, nil,nil,top_level,0);
  386.  
  387.   CAR(interpreter_thread)->THREAD.fun = function_read_eval_print;
  388.   CAR(interpreter_thread)->THREAD.status = THREAD_LIMBO;
  389.   system_thread_rig(stacktop,CAR(interpreter_thread));
  390.  
  391.   /* Install as ready... */
  392.  
  393.   EUCALL_2(Fn_thread_start,CAR(interpreter_thread),nil);
  394.  
  395.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  396. #ifndef KJP
  397.   start_history();
  398. #endif
  399.  
  400.   /* Store as the top level thread... */
  401.   
  402.   tl_thread = CAR(interpreter_thread);
  403.  
  404.   /* Name and configuration... */
  405.  
  406.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  407.  
  408. #ifdef KJP
  409.  
  410. #ifdef MACHINE_SYSTEMV
  411.   printf("KJP-SystemV)");
  412. #endif
  413. #ifdef MACHINE_BSD
  414.   printf("KJP-BSD)");
  415. #endif
  416. #ifdef MACHINE_ANY
  417.   printf("KJP-Generic)");
  418. #endif
  419. #ifdef FIX_LEVEL
  420.   printf(" (fix %d)",FIX_LEVEL);
  421. #endif
  422.  
  423. #else /* KJP */
  424.  
  425. #ifdef MACHINE_SYSTEMV
  426.   printf("SystemV)");
  427. #endif
  428. #ifdef MACHINE_BSD
  429.   printf("BSD)");
  430. #endif
  431. #ifdef MACHINE_ANY
  432.   printf("Generic)");
  433. #endif
  434. #ifdef FIX_LEVEL
  435.   printf(" (fix %d)",FIX_LEVEL);
  436. #endif
  437.  
  438. #endif /* KJP */
  439.  
  440.   printf(" %s\n",MAKE_DATE);
  441.   printf("\n");
  442.  
  443. #ifdef VERSION_MESSAGE
  444.   printf("                    Version Message\n\n");
  445.   printf(VERSION_MESSAGE);
  446.   printf("\n");
  447. #endif
  448.  
  449.   fflush(stdout);
  450.   ON_collect();
  451.   
  452.   {LispObject xx;
  453.  
  454.    xx=boot_thread;
  455.    boot_thread=nil;
  456.    runtime_begin_processes(xx->THREAD.state->CONTINUE.gc_stack_pointer);
  457.  }
  458. }
  459.  
  460. #else
  461.  
  462. void start_interpreter(LispObject *stacktop)
  463. {
  464.   void start_history(void);
  465.  
  466.   /* Generate the interpreter thread... */
  467.  
  468.   CAR(interpreter_thread )
  469.     = allocate_thread(stacktop, 0,INTERPRETER_THREAD_GC_STACK_SIZE,0);
  470.   CAR(interpreter_thread)->THREAD.fun = nil;
  471.   CAR(interpreter_thread)->THREAD.status = THREAD_RUNNING;
  472.  
  473.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  474.  
  475. #ifndef KJP
  476.   start_history();
  477. #endif
  478.  
  479.   /* Store as the top level thread... */
  480.  
  481.   CAR(tl_thread) = CAR(interpreter_thread);
  482.   /* Name and configuration... */
  483.   ON_collect();
  484.  
  485.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  486.  
  487. #ifdef KJP
  488.  
  489. #ifdef MACHINE_SYSTEMV
  490.   printf("KJP-SystemV)");
  491. #endif
  492. #ifdef MACHINE_BSD
  493.   printf("KJP-BSD)");
  494. #endif
  495. #ifdef MACHINE_ANY
  496.   printf("KJP-Generic)");
  497. #endif
  498. #ifdef FIX_LEVEL
  499.   printf(" (fix %d)",FIX_LEVEL);
  500. #endif
  501.  
  502. #else /* KJP */
  503.  
  504. #ifdef MACHINE_SYSTEMV
  505.   printf("SystemV)");
  506. #endif
  507. #ifdef MACHINE_BSD
  508.   printf("BSD)");
  509. #endif
  510. #ifdef MACHINE_ANY
  511.   printf("Generic)");
  512. #endif
  513. #ifdef FIX_LEVEL
  514.   printf(" (fix %d)",FIX_LEVEL);
  515. #endif
  516.  
  517. #endif /* KJP */
  518.  
  519.   printf(" %s\n",MAKE_DATE);
  520.   printf("\n");
  521.  
  522. #ifdef VERSION_MESSAGE
  523.   printf("                    Version Message\n\n");
  524.   printf(VERSION_MESSAGE);
  525.   printf("\n");
  526. #endif
  527.  
  528.   fflush(stdout);
  529.  
  530.   stacktop = load_thread(CAR(tl_thread)); /* So repl continue has the right thread base */
  531.   ON_collect();
  532.   (void) top_level(stacktop);
  533. }
  534.  
  535. #endif
  536.  
  537. void load_and_boot(LispObject *stacktop)
  538. {
  539.   extern MODULE Module_generics;
  540.   extern int gc_enabled;
  541.   extern void initialise_elvira_modules(LispObject *);
  542.  
  543.   bootstrap(stacktop); /* Bootstrap classes and some special symbols */
  544.   initialise_modules(stacktop);
  545.   initialise_symbols(stacktop); /* Rig up the others */
  546.   initialise_specials(stacktop);
  547.   initialise_root(stacktop);
  548.  
  549.   /* Hacked history */
  550.  
  551.   make_special_symbol(stacktop, &last_evaluated_expression, ":last" );
  552.  
  553.   /* Open up the other module and do the rest */
  554.  
  555.   open_module(stacktop,
  556.           &Module_others,Module_others_values,"others",OTHER_ENTRIES);
  557.  
  558.   initialise_set(stacktop);
  559.   initialise_basic(stacktop);
  560.   initialise_garbage(stacktop);
  561.   initialise_macros(stacktop);
  562.  
  563.   close_module();    
  564.   lval_typeof((LispObject)&Module_generics)=TYPE_C_MODULE;
  565.   
  566.   /* Initialise the modular sections */
  567.  
  568.   initialise_error(stacktop);
  569.   initialise_classes(stacktop);
  570.   initialise_streams(stacktop);
  571.   initialise_generics(stacktop);
  572.   initialise_ccc(stacktop);
  573.   initialise_lists(stacktop);
  574.   initialise_listops(stacktop);
  575.   initialise_tables(stacktop);
  576.   initialise_vectors(stacktop);
  577.   initialise_chars(stacktop);
  578.   initialise_calls(stacktop);
  579.   initialise_arith(stacktop);
  580.   initialise_threads(stacktop);
  581.   initialise_semaphores(stacktop);
  582.  
  583.   initialise_formatted_io(stacktop);
  584.   initialise_module_operators(stacktop);
  585.  
  586. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  587.   {
  588.     extern void initialise_sockets(LispObject *);
  589.     initialise_sockets(stacktop);
  590.   }
  591. #endif
  592.   initialise_bit_vectors(stacktop);
  593.  
  594. #ifdef WITH_BIGNUMS
  595.   initialise_bignums(stacktop);
  596. #endif
  597.  
  598. #ifdef BCI
  599.   initialise_bci(stacktop);
  600. #endif
  601.   /* Set up Elvira modules... */
  602.  
  603.   /* Note: because these may contain init-errors, we provide a handler */
  604.  
  605.   {
  606.     extern LispObject function_bootstrap_handler;
  607.     LispObject xx;
  608.  
  609.     EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  610.     HANDLER_STACK() =
  611.       CURRENT_THREAD()->THREAD.state->CONTINUE.handler_stack 
  612.     = xx;
  613.   }
  614.  
  615.   initialise_elvira_modules(stacktop);
  616. }
  617.  
  618. LispObject read_eval_print_continue;
  619.  
  620. /* This top-level is the function which is run on the interpreter thread... */
  621.  
  622. int command_line_do_done_flag;
  623. int feelrc_read_flag;
  624.  
  625. LispObject top_level(LispObject *stacktop)
  626. {
  627.   extern char *command_line_do_string;
  628.   extern int command_line_map_flag;
  629.   LispObject get_history_form(LispObject);
  630.   void put_history_form(LispObject *,LispObject);
  631.   int get_history_count(void);
  632.   void initialise_input_processing(void);
  633.   LispObject process_input_form(LispObject);
  634.   LispObject process_result_form(LispObject);
  635.   void make_description_file(LispObject *);
  636.  
  637.   if (command_line_map_flag) make_description_file(stacktop);
  638.  
  639.   CODBG(fprintf(stderr,"Entering toplevel on thread %d\n",THIS_PROCESS));
  640.  
  641.   current_output = (StdOut->STREAM).handle;
  642.   SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  643.     get_module(stacktop,sym_root);
  644.  
  645.   command_line_do_done_flag = FALSE;
  646.   feelrc_read_flag = FALSE;
  647.  
  648. #ifdef KJP
  649.   initialise_input_processing();
  650. #endif
  651.  
  652.   /* Load the initialisation module/bootfile */
  653. #ifdef BCI
  654.   if (command_line_boot_file!=NULL)
  655.     {
  656.       LispObject str;
  657.       str=allocate_string(stacktop,command_line_boot_file,strlen(command_line_boot_file)+1);
  658.       EUCALL_1(Fn_load_bytecodes,str);
  659.     }
  660.   else
  661. #endif
  662.     {
  663.       LispObject sym_init;
  664.       extern LispObject function_bootstrap_handler;
  665.       extern LispObject function_default_handler;
  666.       LispObject xx,oldstack;
  667.  
  668.       sym_init=get_symbol(stacktop,"initcode");
  669.  
  670.       EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  671.       HANDLER_STACK() = xx;
  672.  
  673.       EUCALL_1(load_module,sym_init);
  674.       HANDLER_STACK()=CDR(xx);
  675.  
  676.       EUCALLSET_2(xx,Fn_cons,function_default_handler,nil);
  677.       HANDLER_STACK() = xx;
  678.     
  679.     }
  680.  
  681.  
  682.  reset:
  683.  
  684.   if (set_continue(stacktop,CAR(read_eval_print_continue))) {
  685.  
  686.     if (CAR(read_eval_print_continue)->CONTINUE.value == lisptrue) {
  687.       (void) garbage_collect(stacktop);
  688.       printf("\n");
  689.       fflush(stdout);
  690.     }
  691.  
  692. #ifdef KJP
  693.  
  694.     /* Being here implies that no result was returned from the last 
  695.        expression so we'll add a dummy value to the value history   */
  696.  
  697.  
  698.     (void) process_result_form(nil);
  699. #endif
  700.  
  701.     /* Doc Frankenstein would be proud... */
  702.  
  703.     goto reset;
  704.  
  705.   }
  706.  
  707.   /* If do was configured, fix it... */
  708.  
  709.   if (command_line_do_string != NULL && command_line_do_done_flag == FALSE) {
  710.     LispObject command,ans;
  711.     
  712.     command_line_do_done_flag = TRUE;
  713.  
  714.     BUFFER_PTR() = 0;
  715.     strcpy(BUFFER_START(),command_line_do_string);
  716.  
  717.     fprintf(StdOut->STREAM.handle,"Doing: '%s'\n",BUFFER_START());
  718.  
  719.     command = read_object(stacktop);
  720.  
  721.     fprintf(StdOut->STREAM.handle,"Exp: ");
  722.     EUCALL_2(Fn_print,command,StdOut);
  723.  
  724.     EUCALLSET_2(ans,process_top_level_form,
  725.          SYSTEM_GLOBAL_VALUE(current_interactive_module),
  726.          command);
  727.  
  728.     fprintf(StdOut->STREAM.handle,"Done: ");
  729.     EUCALL_2(Fn_print,ans,StdOut);
  730.     fprintf(StdOut->STREAM.handle,"\n");
  731.   }
  732.  
  733.   /* Load the configuration file... */
  734.  
  735.   if (!feelrc_read_flag) {
  736.     extern char *getenv(char *);
  737.     extern LispObject Fn_close(LispObject*);
  738.     char path[1000];
  739.     FILE *inits;
  740.     LispObject initstr;
  741.     char *home;
  742.  
  743.     feelrc_read_flag = TRUE;
  744.  
  745.     home = getenv("HOME");
  746.     if (home == NULL)    
  747.       path[0]='\0';
  748.     else
  749.       strcpy(path,home);
  750.  
  751.     strcat(path, FEEL_RC_FILE );
  752.     inits = fopen(path,"r");
  753.     if (inits != NULL) {
  754.  
  755.       initstr = allocate_stream(stacktop, inits,'r');
  756.       while (TRUE) {
  757.     LispObject form;
  758.     STACK_TMP(initstr);
  759.     EUCALLSET_1(form, Fn_read, initstr);
  760.     UNSTACK_TMP(initstr);
  761.     if (form == q_eof) break;
  762.     STACK_TMP(initstr);
  763.     EUCALL_2(process_top_level_form,
  764.              SYSTEM_GLOBAL_VALUE(current_interactive_module),
  765.              form);
  766.     UNSTACK_TMP(initstr);
  767.       }
  768.       EUCALL_1(Fn_close, initstr);
  769.     }
  770.   }
  771.  
  772.   while (TRUE) {
  773.     extern char current_prompt_string[];
  774.     extern LispObject Gf_generic_write(LispObject*);
  775.     extern LispObject sym_pling_root;
  776.     extern LispObject sym_pling_exit;
  777.     extern int system_scheduler_number;
  778.     LispObject form, ans;
  779.     FILE *current_output;
  780.  
  781.     current_output = (StdOut->STREAM).handle;
  782.  
  783.     sprintf(current_prompt_string,"eulisp:%x:%s!%d> ",system_scheduler_number,
  784.         stringof(SYSTEM_GLOBAL_VALUE(current_interactive_module)
  785.              ->I_MODULE.name->SYMBOL.pname),
  786.         get_history_count());
  787.  
  788. #ifndef GNUREADLINE
  789.     fprintf(current_output,"%s",current_prompt_string);
  790.     fflush(current_output);
  791. #endif
  792.     EUCALLSET_1(form, Fn_read, nil);
  793. #ifdef KJP
  794.     if ((form = process_input_form(form)) == NULL) break;
  795.     ans 
  796.       = process_top_level_form(SYSTEM_GLOBAL_VALUE(current_interactive_module),
  797.                    form);
  798.     ans = process_result_form(ans);
  799. #else
  800.     form = get_history_form(form); /* never allocs */
  801.     STACK_TMP(form);
  802.     put_history_form(stacktop, form);
  803.     UNSTACK_TMP(form);
  804.     if (form == q_eof || form == sym_pling_exit) break;
  805.     if (form == sym_pling_root) {
  806.       SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  807.     get_module(stacktop,sym_root);
  808.       ans = nil;
  809.     }
  810.     else {
  811.       EUCALLSET_2(ans,process_top_level_form,
  812.           SYSTEM_GLOBAL_VALUE(current_interactive_module),
  813.           form);
  814.  
  815.       last_evaluated_expression = ans;
  816.     }
  817. #endif
  818.  
  819.     current_output = (StdOut->STREAM).handle;
  820.  
  821.     if (GC_STACK_POINTER() != GC_STACK_BASE())
  822.       fprintf(current_output,"GC Error: ptr=%d (recovered)\n",
  823.           GC_STACK_POINTER() - GC_STACK_BASE());
  824.     /** hack **/
  825.     GC_STACK_POINTER() = GC_STACK_BASE();
  826.  
  827.     fprintf(current_output,"eulisp:%x:%s!%d< ",system_scheduler_number,
  828.         stringof(SYSTEM_GLOBAL_VALUE(current_interactive_module)
  829.              ->I_MODULE.name->SYMBOL.pname),
  830.         get_history_count()-1);
  831.  
  832.     EUCALL_2(Gf_generic_write,ans,StdOut);
  833.  
  834.     fprintf(current_output,"\n\n");
  835.     fflush(current_output);
  836.  
  837.   }
  838.  
  839.   fprintf(stderr,"\nEuLISP finishing\n\n");
  840.  
  841.   system_lisp_exit(1);
  842.  
  843.   return nil;
  844.  
  845. }
  846.  
  847. /* 
  848.  
  849.  * Configuration... 
  850.  
  851.  */
  852.  
  853. char *command_line_do_string;
  854. int command_line_window_flag;
  855. int command_line_heap_size;
  856. int command_line_stack_space_size;
  857. int command_line_map_flag;
  858. int command_line_processors;
  859. int command_line_interface_flag;
  860. void configure(int argc,char **argv)
  861. {
  862.   extern int command_line_x_debug;
  863.   int i = 1;
  864.  
  865.   /* Nullify options... */
  866.  
  867.   command_line_do_string = NULL;
  868.   command_line_window_flag = FALSE;
  869.   command_line_heap_size = 0;
  870.   command_line_stack_space_size = 0;
  871.   command_line_map_flag = FALSE;
  872.   command_line_x_debug = FALSE;
  873.   command_line_interface_flag = FALSE;
  874.   command_line_processors = 0;
  875.   command_line_boot_file = NULL;
  876.  
  877.   while (i < argc) {
  878.  
  879.     if (strcmp(argv[i],"-do") == 0) {
  880.       if (argc - i < 2) {
  881.     fprintf(stderr,"eulisp: bad -do option\n");
  882.     exit(1);
  883.       }
  884.       command_line_do_string = argv[i+1];
  885.       i+=2;
  886.       continue;
  887.     }
  888.  
  889.     if (strcmp(argv[i],"-win") == 0) {
  890.       command_line_window_flag = TRUE;
  891.       ++i;
  892.       continue;
  893.     }
  894.  
  895.     if (strcmp(argv[i],"-xdebug") == 0 
  896.     || strcmp(argv[i],"-Xdebug") == 0) {
  897.       command_line_x_debug = TRUE;
  898.       ++i;
  899.       continue;
  900.     }
  901.  
  902.     if (strcmp(argv[i],"-boot") == 0 
  903.     || strcmp(argv[i],"-Xdebug") == 0) {
  904.       command_line_boot_file = argv[i+1];
  905.       i+=2;
  906.       continue;
  907.     }
  908.  
  909.     if (strcmp(argv[i],"-heap") == 0) {
  910.       if (argc - i < 2) {
  911.     fprintf(stderr,"eulisp: bad -heap option\n");
  912.     exit(1);
  913.       }
  914.       sscanf(argv[i+1],"%d",&command_line_heap_size);
  915.       i+=2;
  916.       continue;
  917.     }
  918.  
  919.     if (strcmp(argv[i],"-stack-space") == 0) {
  920.       if (argc - i < 2) {
  921.     fprintf(stderr,"eulisp: bad -stack-space option\n");
  922.     exit(1);
  923.       }
  924.       sscanf(argv[i+1],"%d",&command_line_stack_space_size);
  925.       i+=2;
  926.       continue;
  927.     }
  928.  
  929.     if (strcmp(argv[i],"-procs") == 0) {
  930.       if (argc - i < 2) {
  931.     fprintf(stderr,"eulisp: bad -procs option\n");
  932.     exit(1);
  933.       }
  934.       sscanf(argv[i+1],"%d",&command_line_processors);
  935.       if (command_line_processors < 1) {
  936.     fprintf(stderr,"eulisp: bad -procs value\n");
  937.     exit(1);
  938.       }
  939.       if (command_line_processors > MAX_PROCESSORS) {
  940.     fprintf(stderr,"eulisp: -procs value higher than %d maximum\n",
  941.         MAX_PROCESSORS);
  942.     exit(1);
  943.       }
  944.       i+=2;
  945.       continue;
  946.     }
  947.  
  948.     if (strcmp(argv[i],"-map") == 0) {
  949.       command_line_map_flag = TRUE;
  950.       ++i;
  951.       continue;
  952.     }
  953.  
  954.     if (strcmp(argv[i],"-gen-interfaces") == 0) {
  955.       command_line_interface_flag = TRUE;
  956.       ++i;
  957.       continue;
  958.     }
  959.  
  960.     fprintf(stderr,"eulisp: unknown option '%s'\n",argv[i]);
  961.     exit(1);
  962.  
  963.   }
  964.  
  965.   /* From environment */
  966. }
  967.  
  968. #ifdef KJP
  969.  
  970. /*
  971.  ** Hacked histories...
  972.  **
  973.  **   One to redo commands and one for values.
  974.  */
  975.  
  976. typedef struct history_structure {
  977.   LispObject value_list;
  978.   int        count;
  979. } History;
  980.  
  981. /* Abstract operations */
  982.  
  983. static void initialise_history(History *h)
  984. {
  985.   h->value_list = nil;
  986.   h->count = 0;
  987. }
  988.  
  989. static void add_history_value(History *h,LispObject value)
  990. {
  991.   extern LispObject Fn_nconc(LispObject*);
  992.  
  993.   ++(h->count);
  994.   EUCALLSET_2(value, Fn_cons, value, nil);
  995.   EUCALLSET_2(h->value_list, Fn_nconc, h->value_list,value);
  996. }
  997.  
  998. static LispObject get_history_value(History *h,int n)
  999. {
  1000.   LispObject walker;
  1001.   int i;
  1002.  
  1003.   if (n > h->count) return(NULL);
  1004.  
  1005.   for (walker = h->value_list, i = 0; i < n; ++i, walker = CDR(walker));
  1006.  
  1007.   return(CAR(walker));
  1008. }
  1009.  
  1010. static void show_history(History *h)
  1011. {
  1012.   int i;
  1013.   LispObject walker;
  1014.  
  1015.   EUDECL(Gf_generic_write);
  1016.  
  1017.   for (i = 0, walker = h->value_list;
  1018.          is_cons(walker); 
  1019.            ++i, walker = CDR(walker)) {
  1020.  
  1021.     printf("%d: ",i);
  1022.     (void) EUCALL_2(Gf_generic_write,CAR(walker),StdOut);
  1023.     printf("\n");
  1024.     fflush(stdout);
  1025.  
  1026.   }
  1027.  
  1028. }
  1029.  
  1030. /* Our histories... */
  1031.  
  1032. /* Input history */
  1033.  
  1034. static SYSTEM_GLOBAL(History *,input_history);
  1035.  
  1036. /* Value history */
  1037.  
  1038. static SYSTEM_GLOBAL(History *,value_history);
  1039.  
  1040. static int history_index(History *h,LispObject sym,char *prefix)
  1041. {
  1042.   int len,index,i;
  1043.  
  1044.   len = strlen(prefix);
  1045.  
  1046.   /* Too short or not right? */
  1047.  
  1048.   if (strlen(stringof(sym->SYMBOL.pname)) < len) return(-1);
  1049.   if (strncmp(stringof(sym->SYMBOL.pname),prefix,len) != 0) return(-1);
  1050.  
  1051.   /* Exactly right? */
  1052.  
  1053.   if (strlen(stringof(sym->SYMBOL.pname)) == len) return(h->count-1);
  1054.  
  1055.   /* All digits */
  1056.  
  1057.   for (i = len; stringof(sym->SYMBOL.pname)[i] != '\0'; ++i)
  1058.     if (!isdigit(stringof(sym->SYMBOL.pname)[i])) return(-1);
  1059.  
  1060.   /* Get the number */
  1061.  
  1062.   sscanf(&(stringof(sym->SYMBOL.pname)[len]),"%d",&index);
  1063.  
  1064.   /* OK? */
  1065.  
  1066.   if (index >= h->count || index < 0) return(-1);
  1067.  
  1068.   return(index);
  1069.  
  1070. }
  1071.  
  1072. void add_input_history_value(LispObject form)
  1073. {
  1074.   add_history_value(SYSTEM_GLOBAL_VALUE(input_history),form);
  1075. }
  1076.  
  1077. LispObject input_history_replace(LispObject sym)
  1078. {
  1079.   int index;
  1080.  
  1081.   index = history_index(SYSTEM_GLOBAL_VALUE(input_history),sym,"!");
  1082.  
  1083.   if (index < 0) return(sym);
  1084.  
  1085.   return(get_history_value(SYSTEM_GLOBAL_VALUE(input_history),index));
  1086. }
  1087.   
  1088. void add_value_history_value(LispObject form)
  1089. {
  1090.   add_history_value(SYSTEM_GLOBAL_VALUE(value_history),form);
  1091. }
  1092.  
  1093. LispObject value_history_replace(LispObject sym)
  1094. {
  1095.   int index;
  1096.  
  1097.   index = history_index(SYSTEM_GLOBAL_VALUE(value_history),sym,"!!");
  1098.  
  1099.   if (index < 0) return(sym);
  1100.  
  1101.   return(get_history_value(SYSTEM_GLOBAL_VALUE(value_history),index));
  1102. }
  1103.  
  1104. LispObject replace_with_history_value(LispObject sym)
  1105. {
  1106.   return(value_history_replace(input_history_replace(sym)));
  1107. }
  1108.  
  1109. static void initialise_histories()
  1110. {
  1111.   SYSTEM_INITIALISE_GLOBAL(History *,input_history,
  1112.                (History *) system_static_malloc(sizeof(History)));
  1113.   SYSTEM_INITIALISE_GLOBAL(History *,value_history,
  1114.                (History *) system_static_malloc(sizeof(History)));
  1115.  
  1116.   initialise_history(SYSTEM_GLOBAL_VALUE(input_history));
  1117.   initialise_history(SYSTEM_GLOBAL_VALUE(value_history));
  1118.  
  1119. }
  1120.  
  1121. int get_history_count()
  1122. {
  1123.   return(SYSTEM_GLOBAL_VALUE(input_history)->count);
  1124. }
  1125.  
  1126. #else /* KJP */
  1127.  
  1128. /* Old hacked histories */
  1129.  
  1130. static SYSTEM_GLOBAL(LispObject,history_list);
  1131. static SYSTEM_GLOBAL(int,history_list_length);
  1132. static SYSTEM_GLOBAL(int,history_count);
  1133.  
  1134. int get_history_count()
  1135. {
  1136.   return(SYSTEM_GLOBAL_VALUE(history_count));
  1137. }
  1138.  
  1139. LispObject get_history_form(LispObject obj)
  1140. {
  1141.   LispObject walker;
  1142.   int i,n,pos;
  1143.  
  1144.   if (!is_symbol(obj)) return(obj);
  1145.   if (stringof(obj->SYMBOL.pname)[0] != '!') return(obj);
  1146.  
  1147.   i = 1;
  1148.   while(stringof(obj->SYMBOL.pname)[i] != '\0') {
  1149.     if (!isdigit(stringof(obj->SYMBOL.pname)[i])) return(obj);
  1150.     ++i;
  1151.   }
  1152.  
  1153.   sscanf(&(stringof(obj->SYMBOL.pname)[1]),"%d",&n);
  1154.  
  1155.   if (n > SYSTEM_GLOBAL_VALUE(history_count)) return(nil);
  1156.  
  1157.   pos = SYSTEM_GLOBAL_VALUE(history_list_length) - n - 1;
  1158.  
  1159.   for (walker = SYSTEM_GLOBAL_VALUE(history_list),i = 0; 
  1160.        i < pos;
  1161.        ++i, walker = CDR(walker));
  1162.  
  1163.   return(CAR(walker));
  1164. }
  1165.  
  1166. void put_history_form(LispObject *stacktop, LispObject form)
  1167. {
  1168.   ++SYSTEM_GLOBAL_VALUE(history_count);
  1169.   ++SYSTEM_GLOBAL_VALUE(history_list_length);
  1170.   EUCALLSET_2(SYSTEM_GLOBAL_VALUE(history_list), Fn_cons,
  1171.           form,SYSTEM_GLOBAL_VALUE(history_list));
  1172. }
  1173.  
  1174. void start_history()
  1175. {
  1176.   SYSTEM_INITIALISE_GLOBAL(LispObject,history_list,nil);
  1177.   SYSTEM_INITIALISE_GLOBAL(int,history_list_length,0);
  1178.   SYSTEM_INITIALISE_GLOBAL(int,history_count,0);
  1179.  
  1180.   ADD_SYSTEM_GLOBAL_ROOT(history_list);
  1181. }
  1182.  
  1183. #endif /* KJP */
  1184.  
  1185. #ifdef KJP
  1186.  
  1187. /*
  1188.  ** Noddy input processing 
  1189.  */
  1190.  
  1191. static LispObject sym_pling_root;
  1192. static LispObject sym_pling_exit;
  1193. static LispObject sym_pling_b;
  1194. static LispObject sym_pling_backtrace;
  1195. static LispObject sym_pling_q;
  1196. static LispObject sym_pling_quickie;
  1197. static LispObject sym_pling_c;
  1198. static LispObject sym_pling_commands;
  1199. static LispObject sym_pling_v;
  1200. static LispObject sym_pling_values;
  1201.  
  1202. LispObject process_input_form(LispObject form)
  1203. {
  1204.   
  1205.   add_input_history_value(form);
  1206.  
  1207.   /* We only know about magic symbols */
  1208.  
  1209.   if (!is_symbol(form)) return(form);
  1210.  
  1211.   /* Special symbols... */
  1212.  
  1213.   /* !root */
  1214.  
  1215.   if (form == sym_pling_root) {
  1216.     SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  1217.       get_module(stacktop,sym_root);
  1218.     return(nil);
  1219.   }
  1220.  
  1221.   /* EOF or !exit */
  1222.  
  1223.   if (form == q_eof || form == sym_pling_exit) return(NULL);
  1224.  
  1225.   /* !b or !backtrace */
  1226.  
  1227.   if (form == sym_pling_b || form == sym_pling_backtrace) {
  1228.  
  1229.     module_eval_backtrace();
  1230.     return(nil);
  1231.  
  1232.   }
  1233.  
  1234.   /* !q or !quickie */
  1235.  
  1236.   if (form == sym_pling_q || form == sym_pling_quickie) {
  1237.  
  1238.     quickie_module_eval_backtrace();
  1239.     return(nil);
  1240.  
  1241.   }
  1242.  
  1243.   /* !c or !commands */
  1244.  
  1245.   if (form == sym_pling_c || form == sym_pling_commands) {
  1246.  
  1247.     show_history(SYSTEM_GLOBAL_VALUE(input_history));
  1248.     return(nil);
  1249.  
  1250.   }
  1251.  
  1252.   /* !v or !values */
  1253.  
  1254.   if (form == sym_pling_v || form == sym_pling_values) {
  1255.  
  1256.     show_history(SYSTEM_GLOBAL_VALUE(value_history));
  1257.     return(nil);
  1258.  
  1259.   }
  1260.  
  1261.   /* We know nothing! */
  1262.  
  1263.   return(form);
  1264.  
  1265. }
  1266.  
  1267. LispObject process_result_form(LispObject form)
  1268. {
  1269.   add_value_history_value(form);
  1270.   return(form);
  1271. }
  1272.  
  1273. void initialise_input_processing()
  1274. {
  1275.   initialise_histories();
  1276.  
  1277.   sym_pling_root = get_symbol(stacktop,"!root");
  1278.   sym_pling_exit = get_symbol(stacktop,"!exit");
  1279.   sym_pling_b = get_symbol(stacktop,"!b");
  1280.   sym_pling_backtrace = get_symbol(stacktop,"!backtrace");
  1281.   sym_pling_q = get_symbol(stacktop,"!q");
  1282.   sym_pling_quickie = get_symbol(stacktop,"!quickie");
  1283.   sym_pling_c = get_symbol(stacktop,"!c");
  1284.   sym_pling_commands = get_symbol(stacktop,"!commands");
  1285.   sym_pling_v = get_symbol(stacktop,"!v");
  1286.   sym_pling_values = get_symbol(stacktop,"!values");
  1287. }
  1288.  
  1289. #endif /* KJP */
  1290.  
  1291.  
  1292.